
{***********************************************************}
{                                                           }
{      Informix Data Access Components                      }
{                                                           }
{      TIfxFileMonitor component                            }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit IfxFileMonitor;

{$I lx.inc}

interface

uses
  SysUtils, Classes, Windows, IfxMonitor;


const

{ Property Default Values }

  IFX_DEFAULT_DO_BACKUP = False;


type

{ TIfxFileMonitor }

  TIfxFileMonitor = class(TIfxCustomMonitor)
  private
    FDoBackUp: Boolean;
    FFileName: string;
    FFileHandle: THandle;
    procedure InternalResetFile;
    procedure InternalCloseFile;
    procedure BackUpFile;
    procedure Write(const TimeStamp, ThreadId, EventType, Message: string);
  protected
    procedure InternalHandleEvent(EventType: TIfxMonitorEventType;
      const Message: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetFile;
  published
    property DoBackUp: Boolean read FDoBackUp write FDoBackUp default IFX_DEFAULT_DO_BACKUP;
    property FileName: string read FFileName write FFileName;
  end;


implementation

uses {$IFNDEF D6} FileCtrl, LXConsts, {$ENDIF}IfxConsts, Ifx;


{ TIfxFileMonitor }

constructor TIfxFileMonitor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDoBackUp := IFX_DEFAULT_DO_BACKUP;
  FFileHandle := INVALID_HANDLE_VALUE;
end;

destructor TIfxFileMonitor.Destroy;
begin
  InternalCloseFile;

  inherited;
end;

procedure TIfxFileMonitor.InternalResetFile;
var
  FileDir: string;
begin
  InternalCloseFile;

  if FFileName = '' then
    IDACError(SMissedFileName, Self);

  if FDoBackUp then BackUpFile;

  FileDir := ExtractFileDir(FFileName);
  if FileDir <> '' then
    ForceDirectories(FileDir);
  FFileHandle := CreateFile(PChar(FFileName), GENERIC_WRITE, FILE_SHARE_READ,
    nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

  if FFileHandle = INVALID_HANDLE_VALUE then
    IDACErrorFmt(SCannotCreateFile, [SysErrorMessage(GetLastError)], Self);

  Write(STimeStampHeader, SThreadIDHeader, SEventTypeHeader, SMessageHeader +
    SLineBreak);
end;

procedure TIfxFileMonitor.InternalCloseFile;
begin
  if FFileHandle <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(FFileHandle);
    FFileHandle := INVALID_HANDLE_VALUE;
  end;
end;

procedure TIfxFileMonitor.BackUpFile;
var
  BkupFileName: string;
begin
  if FileExists(FFileName) then
  begin
    BkupFileName := ChangeFileExt(FFileName, '') + '_' +
      StringReplace(DateTimeToStr(Now), ':', '_', [rfReplaceAll]) +
      ExtractFileExt(FFileName);
    RenameFile(FFileName, BkupFileName);
  end;
end;

procedure TIfxFileMonitor.Write(const TimeStamp, ThreadId, EventType,
  Message: string);
var
  Buffer: string;
begin
  Buffer := Format('%-19s  %-10s  %-12s  %s' + SLineBreak, [TimeStamp, ThreadId,
    EventType, Message]);
  FileWrite(FFileHandle, PChar(Buffer)^, Length(Buffer));
end;

procedure TIfxFileMonitor.InternalHandleEvent(EventType: TIfxMonitorEventType;
  const Message: string);
begin
  if FFileHandle = INVALID_HANDLE_VALUE then
    InternalResetFile;
  Write(DateTimeToStr(Now), IntToStr(GetCurrentThreadId),
    EventTypeToString[EventType], Message);
end;

procedure TIfxFileMonitor.ResetFile;
begin
  SyncLock.Enter;
  try
    InternalResetFile;
  finally
    SyncLock.Leave;
  end;
end;


end.